
Option Public

Dim s As NotesSession
Dim db As NotesDatabase
Dim view As NotesView

Sub Initialize
	
	Set s = New NotesSession
	Set db = s.CurrentDatabase
	
End Sub

Sub GenerateReport ( result As String )
	
	'------------------------------------------------------------------------
	'---- Build data arrays for the selected view
	'------------------------------------------------------------------------
	Dim x As Integer
	Set view = db.GetView( result$ )
	x=0	
	Forall c In view.Columns
		If c.IsField Then 
			
			' Build an array of column names
			Redim Preserve ColumnName(x) As String
			ColumnName(x) = c.Title
			
			' Build an array of column Widths			
			Redim Preserve ColumnWidth(x) As Variant
			ColumnWidth(x) = c.width
			
			' Build an array of column field names
			Redim Preserve FieldName(x) As String
			FieldName(x) = c.ItemName			
			
			x = x + 1	
		End If
	End Forall
	
	'------------------------------------------------------------------------
	'---- Create spreadsheet based on the selected view.
	'---- Parm1 - array of all valid fields in the view
	'---- Parm2 - array of the column titles
	'---- Parm3 - array of the column widths
	'---- Parm4 - the name of the view
	'---- Parm5 - total number of columns in the view	
	'------------------------------------------------------------------------
	Call CreateSpreadsheet ( FieldName , ColumnName, ColumnWidth,  view.Name, x-1 )
	
End Sub

Sub CreateSpreadsheet ( field As Variant, column As Variant, ColWidth As Variant, Sheetname As String, cntr As Integer)
	
	On Error Goto oops
	Dim file As Variant
	Dim wksSheet As Variant
	Dim filename As String		
	Dim alphabet(25) As String
	Dim cell As String
	Dim value As String	
	Dim doc As NotesDocument
	Dim row As Long
	Dim x As Integer	
	Dim n As Integer	
	
	'------------------------------------------------------------------------
	'---- Build the filename for the spreadsheet
	'------------------------------------------------------------------------	
	Dim theDate As String
	Dim theTime As String
	theDate = removeString ( Format(Date$, "Medium Date"), "-")
	theTime = removeString ( Format(Time$, "Long Time"), ":")
	theTime = removeString ( theTime, " ")
	Filename = "C:\Report" + "_" + theDate + "_" + theTime
	Print "Building file: " + Filename	
	
	'------------------------------------------------------------------------
	'---- Build an array of the alphabet
	'------------------------------------------------------------------------	
	For n = 65 To 90
		'Print "Letter" + Cstr(n-65) + " = " + Chr$(n)
		alphabet(n-65) = Chr$(n)
	Next
	
	'------------------------------------------------------------------------
	'---- Create the spreadsheet file object
	'------------------------------------------------------------------------
	Set file = CreateObject("Excel.Application") 
	file.Visible = False
	file.DisplayAlerts = False
	file.Workbooks.Add
	Set wksSheet = file.Worksheets.Add
	wksSheet.name = Sheetname
	file.Worksheets("Sheet1").Delete
	file.Worksheets("Sheet2").Delete
	file.Worksheets("Sheet3").Delete
	Set wksSheet = file.Worksheets( Sheetname )
	wksSheet.Select
	
	'------------------------------------------------------------------------
	'---- Set the column width for first 26 columns
	'------------------------------------------------------------------------
	For x=0 To cntr
		wksSheet.columns( Alphabet(x) ).Columnwidth = Cint ( colWidth(x) + 5 )
	Next
	Print "Set the default column width complete."
	
	'------------------------------------------------------------------------	
	'---- Set font style for spreadsheet
	'------------------------------------------------------------------------
	With file.Range("A:Z")
		.WrapText = True
		.Font.Name = "Arial"
		.Font.FontStyle = "Regular"
		.Font.Size = 8
	End With
	Print "Set the font style complete."
	
	'------------------------------------------------------------------------	
	'----Set font style for header row
	'------------------------------------------------------------------------
	With file.Range("A1:Z1")
		.WrapText = True
		.Font.Name = "Arial"
		.Font.FontStyle = "Bold"
		.Font.Size = 8
	End With
	Print "Spreadsheet initialized."
	
	'------------------------------------------------------------------------
	'---- Load the spreadsheet with data
	'------------------------------------------------------------------------
	Print "Starting data load into spreadsheet... please be patient."	
	Set view = db.GetView( SheetName )
	Set doc = view.GetFirstDocument
	row = 1
	
	' Create the column title row
	Set wksSheet = file.Worksheets( Sheetname )
	wksSheet.Select
	For x=0 To cntr
		cell$ = Alphabet(x) + Cstr( row )
		file.Range( cell$ ).Select	
		file.Activecell.FormulaR1C1 = Column(x)
	Next		
	row = 2
	
	' Create the data rows 	
	While Not(doc Is Nothing)		
		Set wksSheet = file.Worksheets( Sheetname )
		wksSheet.Select
		'Loop through each column and add data to the row
		For x=0 To cntr
			cell$ = Alphabet(x) + Cstr( row )
			file.Range( cell$ ).Select
			file.Activecell.FormulaR1C1 = doc.GetItemValue( field(x) ) 				
		Next		
		Set doc = view.GetNextDocument( doc )
		row = row + 1				
	Wend
	Print "Data load complete."
	
	'------------------------------------------------------------------------	
	'---- Save, close and email file to the person
	'------------------------------------------------------------------------
	file.activeworkbook.saveas Filename
	file.activeworkbook.close 	
	
	' Comment out the following line to skip sending the email
	SendReport ( Filename )
	Print "Report sent."
	
	' Comment out the following line to save file to the harddrive
	Kill Filename+".xls"
	
	Set file = Nothing
	Exit Sub 
	
oops:
	Msgbox "Error" & Str(Err) & ": " & Error$	
	file.activeworkbook.close
	Kill Filename+".xls"
	
End Sub

Function RemoveString ( object As String, SearchString As String) As Variant
	
	Dim tempString As String
	Dim j As Integer
	tempString = ""
	For j% = 1 To Len( object )
		If Mid$(object, j%, 1) <> SearchString Then
			tempString = tempString + Mid$(object, j%, 1)
		End If
	Next
	RemoveString = tempString
	
End Function 

Sub SendReport ( filename As String ) 
	
	Dim PersonName As New NotesName(s.UserName)
	Dim rtitem As NotesRichTextItem
	Dim object As NotesEmbeddedObject
	Dim doc As NotesDocument  	
	Set doc = New NotesDocument( db )
	doc.Form = "Memo"	
	doc.SendTo = PersonName.Abbreviated
	doc.Subject = "Report -- " + filename
	Set rtitem = New NotesRichTextItem( doc, "Body" )
	Call rtitem.AddNewline(1)
	Call rtitem.AppendText("Attached below is the requested report. ")
	Call rtitem.AddNewline(2)
	Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", Filename+".xls")
	doc.Send False
	Msgbox "The requested report has been sent to you.", 0, "Success"	
	
End Sub

Sub PromptUser
	
	Dim w As New NotesUiWorkspace
	Dim view As NotesView
	Dim x As Integer
	Dim result As String
	
	'---------------------------------------------------------------------------	
	' Build an array of views in the database
	'---------------------------------------------------------------------------	
	x=0
	If Not Isempty (db.Views) Then
		Forall v In db.Views
			Redim Preserve myList(x) As String
			myList(x) = v.Name
			x = x + 1	
		End Forall
	End If
	
	'---------------------------------------------------------------------------	
	' Ask the user to select a view to generate the spreadsheet
	'---------------------------------------------------------------------------	
	result$ = w.Prompt( PROMPT_OKCANCELCOMBO, +_ 
	"Make your choice" , "Select a view to build the spreadsheet", +_
	"select new phase", myList)
	If result$ <> "" Then
		Print "Found view: " + result$
		Call GenerateReport ( result$ )
	End If
	Print "Complete"
	
End Sub
x